home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue42 / opengl / TestForm.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1998-11-24  |  5.9 KB  |  217 lines
  1. unit TestForm;
  2.  
  3. interface
  4. {$W+}//set stack frames on as this seemms to help win95 access error
  5.  
  6. uses
  7.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  8.   glwin, StdCtrls, Buttons,opengl,common,glfuncs, ToolWin, ComCtrls, ExtCtrls, {glaux,}
  9.   GLCtrolP, glAbsWin, glLight, GLTexWin{,glprint},dualwin, glStereo,printers;
  10.  
  11. type
  12.   TForm1 = class(TForm)
  13.     ToolBar1: TToolBar;
  14.     SpeedButton1: TSpeedButton;
  15.     PrintTest: TButton;
  16.     sb1: TStatusBar;
  17.     PrintDialog1: TPrintDialog;
  18.     procedure FormCreate(Sender: TObject);
  19.     procedure glwMouseUp(Sender: TObject; Button: TMouseButton;
  20.       Shift: TShiftState; X, Y: Integer);
  21.     procedure SpeedButton6Click(Sender: TObject);
  22.     procedure SpeedButton7Click(Sender: TObject);
  23.     procedure SpeedButton1Click(Sender: TObject);
  24.     procedure FormDestroy(Sender: TObject);
  25.     procedure PrintTestClick(Sender: TObject);
  26.     procedure Button1Click(Sender: TObject);
  27.     procedure OpenGLWindow1SelectDown(Sender: TCustomOpenGLWindow; XPos,
  28.       YPos: Integer; WX, WY, WZ: Double; var RedrawNeeded: Boolean;
  29.       var SelectState: GLSelectState);
  30.     procedure OpenGLWindow1SelectMove(Sender: TCustomOpenGLWindow; XPos,
  31.       YPos: Integer; WX, WY, WZ: Double; var RedrawNeeded: Boolean;
  32.       var SelectState: GLSelectState);
  33.     procedure OpenGLWindow1SelectUp(Sender: TCustomOpenGLWindow; XPos,
  34.       YPos: Integer; WX, WY, WZ: Double; var RedrawNeeded: Boolean;
  35.       var SelectState: GLSelectState);
  36.     procedure SpeedButton2Click(Sender: TObject);
  37.     procedure OpenGLWindow1Paint(sender: TCustomOpenGLWindow;
  38.       aCanvas: TCanvas; SafeGDI: Boolean);
  39.     procedure FormShow(Sender: TObject);
  40.   private
  41.     { Private declarations }
  42.     GLW:TOPENGLWindow;
  43.  
  44.   public
  45.     { Public declarations }
  46.   end;
  47.  
  48. var
  49.   Form1: TForm1;
  50.  
  51. implementation
  52.  
  53. uses bmapview;
  54.  
  55. {$R *.DFM}
  56.  
  57. procedure TForm1.FormCreate(Sender: TObject);
  58. begin
  59.   GLW:= TOPENGLWindow.Create(Self);
  60.   GLW.Parent:=Self;
  61. end;
  62.  
  63. procedure TForm1.FormDestroy(Sender: TObject);
  64. begin
  65.  GLW.Free;
  66. end;
  67. procedure TForm1.glwMouseUp(Sender: TObject; Button: TMouseButton;
  68.   Shift: TShiftState; X, Y: Integer);
  69. begin
  70.     If Button =mbRight then GLW.SnapToPoint(0,0,0,'location = 0,0,0');
  71. end;
  72.  
  73. procedure TForm1.SpeedButton6Click(Sender: TObject);
  74. begin
  75.  GLW.Zoomall;
  76. end;
  77.  
  78.  
  79. procedure TForm1.SpeedButton7Click(Sender: TObject);
  80. begin
  81.  GLW.Perspective:= not GLW.Perspective;
  82. end;
  83.  
  84. procedure TForm1.SpeedButton1Click(Sender: TObject);
  85. begin
  86.   If SpeedButton1.Down then  GLW.ShowGLControl(Sender)   else GLW.HideGLControl;
  87. end;
  88.  
  89.  
  90. procedure TForm1.PrintTestClick(Sender: TObject);
  91. Var {aMF                  : tMetaFile;}
  92.     aBM                  : tBitMap;
  93.    { PageResX ,PageResY   : Single;
  94.     V1,V2                : Integer;
  95.     PrintDC              : tHandle;  }
  96. begin
  97.   Screen.Cursor:=crHourglass;
  98.  
  99.   aBM:=tBitMap.create;
  100.   aBM.Width:=800;aBM.Height:=600;
  101.   glw.GetSizedBitMapImage(aBM);
  102.   aBM.SaveToFile('TestBM.bmp');
  103.   aBM.Free;
  104. (*
  105.     PageResX:=20;
  106.     PageResY:=20;
  107.     V1:= Round(250*PageResX);
  108.     V2:= Round(250*PageResY);
  109.  
  110.     aMF:=GLW.getScaledMetaFileImage(V1,V2,PageResX,PageResY,1000);
  111.     If Assigned (aMF) then
  112.     Begin
  113.       aMF.SaveToFile('TestMF.WMF');
  114.       aMF.Free;
  115.     END;
  116.   *)  
  117.   (*
  118.   If PrintDialog1.execute then
  119.      Begin
  120.           With Printer do
  121.             PrintDC:=Printer.Handle;
  122.            // printer resolution
  123.             PageResX:=GetDeviceCaps(PrintDC,LOGPIXELSX)/25.4;
  124.             PageResY:=GetDeviceCaps(PrintDC,LOGPIXELSY)/25.4;
  125.  
  126.             If Assigned (aMF) then
  127.             Begin
  128.               aMF.SaveToFile('TestMF.WMF');
  129.               Printer.Begindoc;
  130.               Printer.Canvas.Draw(100,400,aMF);
  131.               Printer.endDoc;
  132.               aMF.Free;
  133.             end;
  134.       end; *)
  135.   screen.Cursor:=crDefault;
  136. end;
  137.  
  138. procedure TForm1.Button1Click(Sender: TObject);
  139. begin
  140.       Application.CreateForm(Ttestwin,testwin);
  141.       With testwin do
  142.        Begin
  143.         { gl1.ShareGL:=GLW;}
  144.        end;
  145.       testwin.ShowModal;
  146.       testwin.Free;
  147. end;
  148.  
  149. procedure TForm1.OpenGLWindow1SelectDown(Sender: TCustomOpenGLWindow; XPos,
  150.   YPos: Integer; WX, WY, WZ: Double; var RedrawNeeded: Boolean;
  151.   var SelectState: GLSelectState);
  152. begin
  153. {}
  154. end;
  155.  
  156. procedure TForm1.OpenGLWindow1SelectMove(Sender: TCustomOpenGLWindow; XPos,
  157.   YPos: Integer; WX, WY, WZ: Double; var RedrawNeeded: Boolean;
  158.   var SelectState: GLSelectState);
  159. begin
  160.  {}
  161. end;
  162.  
  163. procedure TForm1.OpenGLWindow1SelectUp(Sender: TCustomOpenGLWindow; XPos,
  164.   YPos: Integer; WX, WY, WZ: Double; var RedrawNeeded: Boolean;
  165.   var SelectState: GLSelectState);
  166. begin
  167.  {}
  168. end;
  169.  
  170. procedure TForm1.SpeedButton2Click(Sender: TObject);
  171.   var aRect:TRect;
  172. begin
  173.  SetRectEmpty(aRect);
  174.  aREct.Right:=GLw.Width div 2;
  175.  aRect.Bottom:=GLW.Height div 2;
  176.  GLW.InvalidateRectangle(aRect,True);
  177. end;
  178.  
  179. procedure TForm1.OpenGLWindow1Paint(sender: TCustomOpenGLWindow;
  180.   aCanvas: TCanvas; SafeGDI: Boolean);
  181. begin
  182.   If (Sender is TOpenGLWindow) and (TOpenGLWindow(Sender).TestScene=tsBasicScene) then
  183.   with acanvas do
  184.    begin
  185.      Pen.Color:=clRed;
  186.      Brush.Style:=bsClear;//let the background come through
  187.      Font.color:=clGreen;//use green to show up on black or white background
  188.      TextOut(110,100,'Demo of GDI Text');
  189.      //draw a simple red line
  190.      Moveto(100,100);
  191.      LineTo(200,200);
  192.    end;
  193. end;
  194.  
  195. procedure TForm1.FormShow(Sender: TObject);
  196.  Var GL:tGLPoint;
  197. begin
  198. {}
  199.   glw.align:=alclient;
  200.   GLW.BackGround:=glBlackBkgd;
  201.   GLW.Perspective:=False;
  202.   GLW.HUD:=True;
  203.   GLW.Grid:=True;
  204.   GLW.coords:=SB1.Panels[0];
  205.   GLw.ExtraData:=sb1.Panels[1];
  206.   Application.OnShowHint:=GLW.ShowGLHint;
  207.   glw.grabfocus:=True;
  208.   GL.X:=0; GL.Y:=0;GL.Z:=0;
  209.   glw.RefPoint:=GL;
  210.   GLW.OnPaint:= OpenGLWindow1Paint;
  211.   GLW.Perspective:=True;
  212.   GLW.StdDisplayList:=True;
  213.   GLW.TestScene:=tsColorTriangle;
  214. end;
  215.  
  216. end.
  217.